home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / preiserf.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  12.0 KB  |  408 lines
  1. IMPLEMENTATION MODULE  PreisErfassung;
  2. (*****************************  IMPORT  ******************************)
  3. FROM BlRscInc IMPORT VKPDIA , EKPDIA ,  (* TREE *) VKBIER , VKLIMO ,
  4.                      CANCELVK ,  OKVK , EKB1 , EKB2 , EKB3 , EKB4 , EKB5 , EKB6 ,
  5.                      EKB7 , EKL1 , EKL2 , EKL3 , EKL4 , EKL5 , EKL6 , EKL7 ,
  6.                      CANCELEK , OKEK ,DATEDIA, DATUM, CANCDAT, OKDATUM,
  7.                      SaveFileName;
  8.  
  9. FROM SYSTEM IMPORT ADDRESS;
  10. FROM AES IMPORT FormAlert,ResourceGetAddr;
  11. FROM EasyDialog IMPORT DoDialog,and,GetText,SetText,IsSelected;
  12. FROM ConvertStr IMPORT StrToInt,IntToStr;
  13. FROM Strings IMPORT IsEmptyStr,EqualStr,LeftStr,SubStr,ClearStr,Length,
  14.                     Concat;
  15. FROM InOut IMPORT WriteString,WriteLn,WriteInt,Done,ReadInt,
  16.                   ReadLine,ReadString,
  17.                   OpenOutput,CloseOutput,OpenInput,CloseInput;
  18.  
  19.  
  20. (*************************   VAR ********************************)
  21.  VAR                 EKDiaAddr   : ADDRESS;
  22.                      VKDiaAddr   : ADDRESS;
  23.                      EndStr      : ARRAY [0..5] OF CHAR;
  24.                      i,k         : INTEGER;
  25. (*************************** CONST ******************************)
  26.  
  27. (*************************** BEGIN ******************************)
  28.  
  29. PROCEDURE GetDate():BOOLEAN;
  30. VAR  String,SaveString      :ARRAY [1..6] OF CHAR;
  31.      DateDiaAddr :ADDRESS;
  32.      DiaReturn   :INTEGER;
  33.      dd,mm,jj    :INTEGER;
  34.      OK,Valid    :BOOLEAN;
  35.      Null,UnderScore        : ARRAY [0..0] OF CHAR;
  36.  
  37. BEGIN
  38.   Null[0]:='0'; UnderScore[0]:='_';
  39.   ResourceGetAddr(0,DATEDIA,DateDiaAddr);
  40.   GetText(DATUM,DateDiaAddr,SaveString);
  41.   REPEAT
  42.     DiaReturn:=DoDialog(DateDiaAddr,DATUM);
  43.     Valid:=TRUE;
  44.     IF DiaReturn#CANCDAT THEN
  45.        GetText(DATUM,DateDiaAddr,String);
  46.        SubStr(String,1,2,DD,OK);
  47.  
  48.        StrToInt(DD,dd,OK);
  49.        IntToStr(dd,2,DD,OK);
  50.        Valid:=Valid AND (dd<32);
  51.        SubStr(DD,2,2,DD,OK);
  52.        IF Length(DD)<2 THEN
  53.           Concat(Null,DD,DD,OK);
  54.        END(*IF*);
  55.  
  56.        SubStr(String,3,2,MM,OK);
  57.        StrToInt(MM,mm,OK);
  58.        IntToStr(mm,2,MM,OK);
  59.        Valid:=Valid AND (mm<13);
  60.  
  61.        SubStr(MM,2,2,MM,OK);
  62.        IF Length(MM)<2 THEN
  63.           Concat(Null,MM,MM,OK);
  64.        END(*IF*);
  65.  
  66.  
  67.        SubStr(String,5,2,JJ,OK);
  68.        StrToInt(JJ,jj,OK);
  69.        IntToStr(jj,2,JJ,OK);
  70.        Valid:=Valid AND (jj>93);
  71.        SubStr(JJ,2,2,JJ,OK);
  72.        IF Length(JJ)<2 THEN
  73.           Concat(Null,JJ,JJ,OK);
  74.        END(*IF*);
  75.     ELSE
  76.        SetText(DATUM,DateDiaAddr,SaveString);
  77.     END(*IF*);
  78.     IF Valid THEN
  79.       ClearStr(SaveFileName);
  80.       Concat(SaveFileName,JJ,SaveFileName,OK);
  81.       Concat(SaveFileName,UnderScore,SaveFileName,OK);
  82.       Concat(SaveFileName,MM,SaveFileName,OK);
  83.       Concat(SaveFileName,UnderScore,SaveFileName,OK);
  84.       Concat(SaveFileName,DD,SaveFileName,OK);
  85.       Concat(SaveFileName,'.DAT',SaveFileName,OK);
  86.     END(*IF*);
  87.   UNTIL Valid;
  88.   IF DiaReturn=CANCDAT THEN
  89.      RETURN FALSE
  90.   ELSE
  91.     RETURN TRUE
  92.   END(*IF*);
  93. END GetDate;
  94.  
  95.  
  96.  
  97. PROCEDURE SetVkPreisText;
  98. VAR OK:BOOLEAN;
  99.     VKPString    : ARRAY [0..3] OF CHAR;
  100.     Null   : ARRAY [0..0] OF CHAR;
  101.  
  102. BEGIN
  103.    ResourceGetAddr(0,VKPDIA,VKDiaAddr);
  104.    Null[0]:='0';
  105.    IntToStr( VerkaufsPreis.BierPreis,3,VKPString,OK);
  106.    SubStr(VKPString,2,3,VKPString,OK);
  107.    IF Length(VKPString)<3 THEN
  108.       Concat(Null,VKPString,VKPString,OK);
  109.    END(*IF*);
  110.    IF OK THEN
  111.       SetText(VKBIER,VKDiaAddr,VKPString);
  112.    END(*IF*);
  113.    IntToStr( VerkaufsPreis.LimoPreis,3,VKPString,OK);
  114.    SubStr(VKPString,2,3,VKPString,OK);
  115.    IF Length(VKPString)<3 THEN
  116.       Concat(Null,VKPString,VKPString,OK);
  117.    END(*IF*);
  118.    IF OK THEN
  119.       SetText(VKLIMO,VKDiaAddr,VKPString);
  120.    END(*IF*);
  121. END SetVkPreisText;
  122.  
  123. PROCEDURE ValidInput(String:ARRAY OF CHAR;i:INTEGER):BOOLEAN;
  124. VAR VglStr1,
  125.     VglStr2 : GTString;
  126.     IntStr  : ARRAY[0..1]  OF CHAR;
  127.     OK      : BOOLEAN;
  128.     DM,Pf,FlProKast:INTEGER;
  129.     EKP1,
  130.     EKP2    : EKPreis;
  131. BEGIN
  132.    VglStr1:='';VglStr2:='';
  133.    DM:=0;Pf:=0;FlProKast:=0;
  134.    IF IsEmptyStr(String) THEN RETURN FALSE END(*IF*);
  135.    LeftStr(String,16,VglStr1,OK);
  136.    IF IsEmptyStr(VglStr1) THEN RETURN FALSE END(*IF*);
  137.    VglStr2:='________________';
  138.    LeftStr(VglStr2,16,VglStr2,OK);
  139.    IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
  140.    VglStr2:='                ';
  141.    LeftStr(VglStr2,16,VglStr2,OK);
  142.    IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
  143.    SubStr(String,17,2,IntStr,OK);
  144.    StrToInt(IntStr,DM,OK);
  145.    SubStr(String,19,2,IntStr,OK);
  146.    StrToInt(IntStr,Pf,OK);
  147.    Pf:=100*DM+Pf;
  148.    SubStr(String,21,2,IntStr,OK);
  149.    StrToInt(IntStr,FlProKast,OK);
  150.    IF (Pf=0) OR (FlProKast=0) THEN RETURN FALSE END(*IF*);
  151.    EinKaufsPreis[i].TreeIndex:=i;
  152.    EinKaufsPreis[i].Getraenk:=VglStr1;
  153.    EinKaufsPreis[i].Preis:=Pf;
  154.    EinKaufsPreis[i].FlaschenProKasten:=FlProKast;
  155.    RETURN TRUE
  156. END ValidInput;
  157.  
  158. PROCEDURE LoadPreise;
  159. VAR s      : ARRAY [0..255] OF CHAR;
  160.     String : ARRAY [0..21] OF CHAR;
  161.     Index  : INTEGER;
  162.     OK     : BOOLEAN;
  163.     i      : INTEGER;
  164. BEGIN
  165.    IF Done THEN
  166.       ReadInt(VerkaufsPreis.BierPreis);
  167.       ReadInt(VerkaufsPreis.LimoPreis);
  168.    END(*IF*);
  169.    SetVkPreisText;
  170.    ResourceGetAddr(0,EKPDIA,EKDiaAddr);
  171.    WHILE ~EqualStr(s, EndStr)AND Done DO
  172.       ReadLine(s);
  173.       LeftStr(s,22,String,OK);
  174.       ReadInt(Index);
  175.       i:=Index;
  176.       EinKaufsPreis[i].TreeIndex:=Index;
  177.       ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
  178.       ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
  179.       ReadInt(EinKaufsPreis[i].KaestenGes);
  180.       EinKaufsPreis[i].KaestenGes:= EinKaufsPreis[i].KaestenGes+
  181.                                  EinKaufsPreis[i].NeuBezogeneKaesten;
  182.       EinKaufsPreis[i].ZuBezahlendeKaesten:= EinKaufsPreis[i].NeuBezogeneKaesten+
  183.                                           EinKaufsPreis[i].ZuBezahlendeKaesten;
  184.       EinKaufsPreis[i].NeuBezogeneKaesten:=0;
  185.       IF ValidInput(s,Index) THEN
  186.            SetText(Index,EKDiaAddr,String);
  187.       END(*IF*);
  188.    END(*WHILE*);
  189. END LoadPreise;
  190.  
  191. PROCEDURE LoadOldPreise;
  192. VAR s      : ARRAY [0..255] OF CHAR;
  193.     String : ARRAY [0..21] OF CHAR;
  194.     Index  : INTEGER;
  195.     OK     : BOOLEAN;
  196.  
  197. BEGIN
  198.    IF Done THEN
  199.       ReadInt(VerkaufsPreis.BierPreis);
  200.       ReadInt(VerkaufsPreis.LimoPreis);
  201.    END(*IF*);
  202.    SetVkPreisText;
  203.    ResourceGetAddr(0,EKPDIA,EKDiaAddr);
  204.    WHILE ~EqualStr(s, '#&$!*')AND Done DO
  205.       ReadLine(s);
  206.       LeftStr(s,22,String,OK);
  207.       ReadInt(Index);i:=Index;
  208.       ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
  209.       ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
  210.       ReadInt(EinKaufsPreis[i].KaestenGes);
  211.       IF ValidInput(s,Index) THEN
  212.          SetText(Index,EKDiaAddr,String);
  213.       END(*IF*);
  214.    END(*WHILE*);
  215. END LoadOldPreise;
  216.  
  217.  
  218. PROCEDURE SavePreise;
  219. TYPE     EinString  = ARRAY [0..21] OF CHAR;
  220.  
  221. VAR s:ARRAY [0..255] OF CHAR;
  222.     i,preis:INTEGER;
  223.  
  224.     String      :EinString;
  225.     StrArray    :ARRAY [1..14] OF EinString;
  226. PROCEDURE WritePreis;
  227. BEGIN
  228.     WriteString(String);WriteLn;
  229.     WriteInt(EinKaufsPreis[i].TreeIndex,7);
  230.     WriteInt(EinKaufsPreis[i].NeuBezogeneKaesten,7);
  231.     WriteInt(EinKaufsPreis[i].ZuBezahlendeKaesten,7);
  232.     WriteInt(EinKaufsPreis[i].KaestenGes,7);
  233.     WriteLn;
  234. END  WritePreis;
  235.  
  236. BEGIN
  237.    ClearStr(s);
  238.    IF  Done THEN
  239.       WriteInt(VerkaufsPreis.BierPreis,10);
  240.       WriteInt(VerkaufsPreis.LimoPreis,10);
  241.       WriteLn;
  242.    END(*IF*);
  243.    ResourceGetAddr(0,EKPDIA,VKDiaAddr);
  244.    IF  Done THEN
  245.     FOR i:=EKB1 TO EKB7 DO
  246.          GetText(i,EKDiaAddr,String);
  247.          IF ValidInput(String,i) THEN
  248.          WritePreis;
  249.          END(*IF*);
  250.     END(*FOR*);
  251.     FOR i:=EKL1 TO EKL7 DO
  252.          GetText(i,EKDiaAddr,String);
  253.          IF ValidInput(String,i) THEN
  254.             WritePreis;
  255.          END(*IF*);
  256.     END(*FOR*);
  257.    END(*IF*);
  258.    WriteString(EndStr);WriteLn;
  259.    WriteInt(0,3); WriteInt(0,3);
  260.    WriteInt(0,3); WriteInt(0,3);WriteLn;
  261. END SavePreise;
  262.  
  263. PROCEDURE Nullbelegung(m:INTEGER);
  264. BEGIN
  265.       EinKaufsPreis[m].NeuBezogeneKaesten:=0;
  266.       EinKaufsPreis[m].ZuBezahlendeKaesten:=0;
  267.       EinKaufsPreis[m].KaestenGes:=0;
  268.       EinKaufsPreis[m].Getraenk:='                ';
  269.       EinKaufsPreis[m].Preis:=0;
  270.       EinKaufsPreis[m].FlaschenProKasten:=0;
  271. END  Nullbelegung;
  272.  
  273.  
  274. PROCEDURE Alert;
  275. VAR fr :INTEGER;
  276.     formstr : ARRAY [0..127] OF CHAR;
  277. BEGIN
  278.  
  279.     formstr:='[1][ Sie können den Eintrag erst |löschen wenn diese Getränke| bezahlt sind !][   OK  ]';
  280.     fr:=FormAlert(1,formstr)
  281.  
  282. END Alert;
  283.  
  284. PROCEDURE EinkaufsPreise;
  285. VAR DiaReturn,i   :INTEGER;
  286.     String        :ARRAY [0..21] OF CHAR;
  287.     StringArray   :ARRAY [EKB1..EKL7],[0..21] OF CHAR;
  288.     OK            :BOOLEAN;
  289.  
  290. BEGIN
  291.     ResourceGetAddr(0,EKPDIA,EKDiaAddr);
  292.     FOR i:=EKB1 TO EKB7 DO
  293.           GetText(i,EKDiaAddr,StringArray[i]);
  294.     END(*FOR*);
  295.     FOR i:=EKL1 TO EKL7 DO
  296.          GetText(i,EKDiaAddr,StringArray[i]);
  297.     END(*FOR*);
  298.  
  299.     DiaReturn:=DoDialog(EKDiaAddr,EKB1);
  300.     IF DiaReturn=OKEK THEN
  301.       FOR i:=EKB1 TO EKB7 DO
  302.           GetText(i,EKDiaAddr,String);
  303.           IF ~ValidInput(String,i) THEN
  304.               IF EinKaufsPreis[i].NeuBezogeneKaesten+
  305.                  EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
  306.                  Alert;
  307.                  SetText(i,EKDiaAddr,StringArray[i]);
  308.               ELSE
  309.                  Nullbelegung(i);
  310.               END(*IF*);
  311.           END(*IF*);
  312.       END(*FOR*);
  313.       FOR i:=EKL1 TO EKL7 DO
  314.          GetText(i,EKDiaAddr,String);
  315.          IF ~ValidInput(String,i) THEN
  316.               IF EinKaufsPreis[i].NeuBezogeneKaesten+
  317.                  EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
  318.                  Alert;
  319.                  SetText(i,EKDiaAddr,StringArray[i]);
  320.               ELSE
  321.                  Nullbelegung(i);
  322.               END(*IF*);
  323.          END(*IF*);
  324.       END(*FOR*);
  325.     ELSE
  326.       FOR i:=EKB1 TO EKB7 DO
  327.           SetText(i,EKDiaAddr,StringArray[i]);
  328.       END(*FOR*);
  329.       FOR i:=EKL1 TO EKL7 DO
  330.          SetText(i,EKDiaAddr,StringArray[i]);
  331.       END(*FOR*);
  332.     END(*IF*);
  333. END EinkaufsPreise;
  334.  
  335. PROCEDURE VerkaufsPreise;
  336. VAR DiaReturn :INTEGER;
  337.     preis     :INTEGER;
  338.     String    : ARRAY [0..2] OF CHAR;
  339.     OK        : BOOLEAN;
  340. BEGIN
  341.     ResourceGetAddr(0,VKPDIA,VKDiaAddr);
  342.     DiaReturn:=DoDialog(VKDiaAddr,VKBIER);
  343.     IF DiaReturn= OKVK THEN
  344.        GetText(VKBIER,VKDiaAddr,String);
  345.        StrToInt(String,preis,OK);
  346.        VerkaufsPreis.BierPreis:=preis;
  347.        GetText(VKLIMO,VKDiaAddr,String);
  348.        StrToInt(String,preis,OK);
  349.        VerkaufsPreis.LimoPreis:=preis;
  350.     ELSE
  351.       SetVkPreisText;
  352.     END(*IF*);
  353. END VerkaufsPreise;
  354.  
  355. PROCEDURE GetPreferences(VAR  Ordnen,LeerZeilen:INTEGER):BOOLEAN;
  356. VAR  DatumStr : ARRAY [0..6] OF CHAR;
  357.     Ordnen1,LeerZeilen1:INTEGER;
  358.     DateDiaAddr :ADDRESS;
  359.     OK : BOOLEAN;
  360.     InfoFileName : ARRAY[0..255] OF CHAR;
  361. BEGIN
  362.    InfoFileName:='BIERKASS.INF';
  363.    OpenInput(InfoFileName);
  364.    IF Done THEN
  365.        ReadString(DatumStr);
  366.        ReadInt(Ordnen1);
  367.        ReadInt(LeerZeilen1);
  368.        IF Done THEN
  369.           ResourceGetAddr(0,DATEDIA,DateDiaAddr);
  370.           SetText(DATUM,DateDiaAddr,DatumStr);
  371.           Ordnen:=Ordnen1;
  372.           LeerZeilen:=LeerZeilen1;
  373.        END(*IF*);
  374.    ELSE
  375.       CloseInput;
  376.       RETURN FALSE
  377.    END(*IF*);
  378.    CloseInput;
  379.    RETURN TRUE
  380. END GetPreferences;
  381.  
  382. PROCEDURE SetPreferences( Ordnen,LeerZeilen:INTEGER);
  383. VAR  DatumStr : ARRAY [1..6] OF CHAR;
  384.     DateDiaAddr :ADDRESS;
  385.     OK : BOOLEAN;
  386.     InfoFileName : ARRAY[0..255] OF CHAR;
  387. BEGIN
  388.    InfoFileName:='BIERKASS.INF';
  389.    OpenOutput(InfoFileName);
  390.    IF Done THEN
  391.        ResourceGetAddr(0,DATEDIA,DateDiaAddr);
  392.        GetText(DATUM,DateDiaAddr,DatumStr);
  393.        WriteString(DatumStr);WriteLn;
  394.        WriteInt(Ordnen,5);
  395.        WriteInt(LeerZeilen,5);
  396.    END(*IF*);
  397.    CloseOutput;
  398. END SetPreferences;
  399.  
  400. BEGIN
  401.     FOR k:= EKB1 TO EKL7 DO
  402.         EinKaufsPreis[k].TreeIndex:=0;
  403.         Nullbelegung(k);
  404.     END(*FOR*);
  405.     EndStr:='#&$!*';
  406.  
  407. END PreisErfassung.
  408.